home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DATETIME.SWG / 0045_BASM Date Functions.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-24  |  3KB  |  100 lines
  1. (* Public domain
  2.  
  3. Author: Marius Ellen, Winsum, Groningen, The Netherlands
  4. Fido 2:282/607.2
  5.  
  6.  After studying several DayOfWeeks i got sick.
  7.  None of them worked really correctly and most
  8.  had over 15 DIV'/MOD's or * in it.
  9.  The Zeller's congruence was the best but the
  10.  routine also contains some range errors. Years
  11.  are only valid from 1..6300 and its really slow,
  12.  so i wrote my own..
  13.  
  14.  
  15.  About the routines..
  16.  routine results valid if year in 0..65536
  17.  month in 1..12, and day in 1..28/29/30/31
  18.  there is absolute no range checking..
  19. *)
  20.  
  21. function DayOfWeek(year,month,day:word):word;
  22. {Returns the day of week, 0=Sun..6=Sat}
  23. assembler; {See 1995}
  24. const mtable:array[0..11] of byte=
  25.   (0,3, 3,6, 1,4, 6,2, 5,0, 3,5);
  26. asm
  27. {(Y+(Y div 4)-(Y div 100)+(Y div 400)-Adjust)mod 7}
  28.         mov    ax,year
  29.         mov    di,ax
  30.         xor    bx,bx
  31.         xor    cx,cx
  32.         mov    si,day
  33.         dec    si
  34.         shr    ax,1; adc cl,0 {si+=year div 4}
  35.         shr    ax,1; adc cl,0
  36.         add    si,ax
  37.         mov    bx,25          {si+=year div 100}
  38.         xor    dx,dx
  39.         div    bx
  40.         sub    si,ax
  41.         shr    ax,1; adc ch,0 {si+=year div 400}
  42.         shr    ax,1; adc ch,0
  43.         add    si,ax
  44.         add    si,di
  45. {if leap-year then decrease days}
  46.         mov    bx,month
  47.         cmp    bx,2;  ja  @Noleap {do not adjust}
  48.         and    cl,cl; jne @NoLeap {year mod 4=0?}
  49.         and    dx,dx; jne @IsLeap {year mod 100=0?}
  50.         and    di,di; je  @NoLeap {year=0?}
  51.         and    ch,ch; jne @Noleap {year mod 400=0?}
  52. @IsLeap:dec    si
  53. @Noleap:xor    ah,ah
  54.         mov    al,byte ptr mTable[bx-1]
  55.         add    ax,si
  56.         mov    bx,7
  57.         xor    dx,dx
  58.         div    bx
  59.         xchg   ax,dx
  60. end;
  61.  
  62. function GetDaysInMonth(Month:Byte;Year:Word):Word;
  63. {Returns the total number of days in a month}
  64. assembler;
  65. asm
  66.         mov    bl,Month
  67.         {What about februari?}
  68.         cmp    bl,2; jne @N
  69.         mov    ax,Year
  70.         shr    ax,1; jc @S
  71.         shr    ax,1; jc @S
  72.         {it's a leap-year}
  73.         mov    cx,25; div cx
  74.         and    dx,dx; jne @T
  75.         {its a century}
  76.         and    al,3;  jne @S
  77.     @T: {leap}
  78.         mov    ax,29; jmp @E
  79.     @S: {noleap}
  80.         mov    ax,28; jmp @E
  81.     @N: {Nope, calc moth day's}
  82.         mov    ax,15
  83.         shr    bl,1; rcl ax,1
  84.         cmp    bl,4; jb @E
  85.         xor    ax,1
  86.     @E:
  87. end;
  88.  
  89. function GetDaysInYear(Year:Word):Word;
  90. {Returns the total number of days in a year}
  91. assembler;
  92. asm
  93.         mov    ax,2
  94.         push   ax
  95.         push   year
  96.         call   GetDaysInMonth
  97.         add    ax,(365-28)
  98. end;
  99.  
  100.